COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Routines to allocate & release the various data blocks used by AL}
C00006 00003	(* initAlloc *)
C00010 00004	(* Internal routines to fool the compiler *)
C00014 00005	(* External routines to allocate & free up nodes *)
C00020 ENDMK
C⊗;
{$NOMAIN	Routines to allocate & release the various data blocks used by AL}
{$OWN		Make it so these global variables are NOT shared }

program alloc;

type 
    (* the following get used for misc record types - i.e. we fake out Pascal's 
	type checking mechanism *)

     u = (used,free);

     s3p = ↑s3;
     s3 = record next: s3p; filler: array [1..2] of integer; end;
     s4p = ↑s4;
     s4 = record next: s4p; filler: array [1..3] of integer; end;
     s6p = ↑s6;
     s6 = record next: s6p; filler: array [1..5] of integer; end;

     s7p = ↑s7;
     vectorp = s7p;
     s7 = record case u of
	    used: (refcnt: integer; val: array [1..3] of real);
	    free: (next: vectorp);
	  end;

     s8p = ↑s8;
     s8 = record next: s8p; filler: array [1..7] of integer; end;

     s11p = ↑s11;
     statementp = s11p;
     s11 = packed record
	     next, last, stlab, exprs: statementp;
	     nlines: integer;
	     bpt: boolean;
	     filler: array [1..5] of integer;
	   end;

     s14p = ↑s14;
     s14 = record next: s14p; filler: array [1..13] of integer; end;

     s25p = ↑s25;
     transp = s25p;
     s25 = record case u of
	     used: (refcnt: integer; val: array [1..3,1..4] of real);
	     free: (next: transp);
	   end;

var {Used to keep lists of the various sizes of nodes we use}
    free3: s3p;		{Used for event, enventry}
    free4: s4p;		{ident, token}
    free6: s6p;		{strng, node, cmoncb}
    free7: s7p;		{vector, varidef}
    free8: s8p;		{frame, envheader}
    free11: s11p;	{statement, environment}
    free14: s14p;	{pdb}
    free25: s25p;	{trans}

(* initAlloc *)

procedure initAlloc; external;
procedure initAlloc;
begin
 free3 := nil;
 free4 := nil;
 free6 := nil;
 free7 := nil;
 free8 := nil;
 free11 := nil;
 free14 := nil;
 free25 := nil;
end;

(* Internal routines to fool the compiler *)

function new3: s3p; 
 var n: s3p;
 begin
 n := free3;
 if n = nil then
   begin
   new(n);
   end
  else free3 := n↑.next;
 new3 := n;
 end;

procedure rel3(n: s3p);
 begin
 n↑.next := free3;
 free3 := n;
 end;

function new4: s4p; 
 var n: s4p;
 begin
 n := free4;
 if n = nil then
   begin
   new(n);
   end
  else free4 := n↑.next;
 new4 := n;
 end;

procedure rel4(n: s4p);
 begin
 n↑.next := free4;
 free4 := n;
 end;

function new6: s6p;
 var n: s6p;
 begin
 n := free6;
 if n = nil then
   begin
   new(n);
   end
  else free6 := n↑.next;
 new6 := n;
 end;

procedure rel6(n: s6p);
 begin
 n↑.next := free6;
 free6 := n;
 end;

function new7: s7p;
 var n: s7p;
 begin
 n := free7;
 if n = nil then
   begin
   new(n);
   end
  else free7 := n↑.next;
 new7 := n;
 end;

procedure rel7(n: s7p);
 begin
 n↑.next := free7;
 free7 := n;
 end;

function new8: s8p;
 var n: s8p;
 begin
 n := free8;
 if n = nil then
   begin
   new(n);
   end
  else free8 := n↑.next;
 new8 := n;
 end;

procedure rel8(n: s8p);
 begin
 n↑.next := free8;
 free8 := n;
 end;

function new11: s11p;
 var n: s11p;
 begin
 n := free11;
 if n = nil then
   begin
   new(n);
   end
  else free11 := n↑.next;
 new11 := n;
 end;

procedure rel11(n: s11p);
 begin
 n↑.next := free11;
 free11 := n;
 end;


function new14: s14p;
 var n: s14p;
 begin
 n := free14;
 if n = nil then
   begin
   new(n);
   end
  else free14 := n↑.next;
 new14 := n;
 end;

procedure rel14(n: s14p);
 begin
 n↑.next := free14;
 free14 := n;
 end;


function new25: s25p;
 var n: s25p;
 begin
 n := free25;
 if n = nil then
   begin
   new(n);
   end
  else free25 := n↑.next;
 new25 := n;
 end;

procedure rel25(n: s25p);
 begin
 n↑.next := free25;
 free25 := n;
 end;

(* External routines to allocate & free up nodes *)

{ 3 word nodes }

function newEvent: s3p;  external;
function newEvent; 
 begin newEvent := new3 end;

procedure relEvent(n: s3p);  external;
procedure relEvent; 
 begin rel3(n); end;

function newEentry: s3p;  external;
function newEentry; 
 begin newEentry := new3; end;

procedure relEentry(n: s3p);  external;
procedure relEentry; 
 begin rel3(n); end;



{ 4 word nodes }

function newIdent: s4p;  external;
function newIdent; 
 begin newIdent := new4; end;

procedure relIdent(n: s4p);  external;
procedure relIdent; 
 begin rel4(n); end;

function newToken: s4p;  external;
function newToken; 
 begin newToken := new4; end;

procedure relToken(n: s4p);  external;
procedure relToken; 
 begin rel4(n); end;


{ 6 word nodes }

function newStrng: s6p;  external;
function newStrng; 
 begin newStrng := new6; end;

procedure relStrng(n: s6p); external;
procedure relStrng;
 begin rel6(n) end;

function newNode: s6p; external;
function newNode;
 begin newNode := new6 end;

procedure relNode(n: s6p); external;
procedure relNode;
 begin rel6(n) end;

function newCmoncb: s6p;  external;
function newCmoncb; 
 begin newCmoncb := new6 end;

procedure relCmoncb(n: s6p);  external;
procedure relCmoncb; 
 begin rel6(n) end;


{ 7 word nodes }

function newVector: vectorp; external;
function newVector;
 var v: vectorp;
 begin
 v := new7;
 v↑.refcnt := 0;	(* Need to reset reference count *)
 newVector := v;
 end;

procedure relVector(v: vectorp); external;
procedure relVector;
 begin rel7(v) end;

function newVaridef: s7p;  external;
function newVaridef; 
 begin newVaridef := new7; end;

procedure relVaridef(n: s7p);  external;
procedure relVaridef; 
 begin rel7(n); end;


{ 8 word nodes }

function newFrame: s8p;  external;
function newFrame; 
 begin newFrame := new8 end;

procedure relFrame(n: s8p);  external;
procedure relFrame; 
 begin rel8(n) end;

function newEheader: s8p;  external;
function newEheader; 
 begin newEheader := new8 end;

procedure relEheader(n: s8p);  external;
procedure relEheader; 
 begin rel8(n) end;


{ 11 word nodes }

function newStatement: statementp; external;
function newStatement;
 var s: statementp;
 begin
 s := new11;
 with s↑ do
  begin next := nil; last := nil; stlab := nil; exprs := nil; bpt := false;
	nlines := 1; end;
 newStatement := s;
 end;

procedure relStatement(n: statementp);  external;
procedure relStatement; 
 begin rel11(n) end;

function newEnvironment: s11p;  external;
function newEnvironment; 
 begin newEnvironment := new11 end;

procedure relEnvironment(n: s11p);  external;
procedure relEnvironment; 
 begin rel11(n) end;



{ 14 word nodes }

function newPdb: s14p;  external;
function newPdb; 
 begin newPdb := new14 end;

procedure relPdb(n: s14p);  external;
procedure relPdb; 
 begin rel14(n) end;



{ 25 word nodes }

function newTrans: transp; external;
function newTrans;
 var t: transp;
 begin
 t := new25;
 t↑.refcnt := 0;
 newTrans := t;
 end;

procedure relTrans(t: transp); external;
procedure relTrans;
 begin rel25(t) end;